package Data::Conveyor::Stage::TransactionIterator;

# $Id: TransactionIterator.pm 13653 2007-10-22 09:11:20Z gr $


use warnings;
use strict;
use Error::Hierarchy::Util 'assert_defined';
use Error::Hierarchy;
use Error ':try';


our $VERSION = '0.01';


use base 'Data::Conveyor::Stage::SingleTicket';


__PACKAGE__
    ->mk_scalar_accessors(qw(factory_method))
    ->mk_boolean_accessors(qw(done));


# Subclasses can override this if they don't want to process certain
# transactions, e.g., a notify stage might want to process all transactions,
# regardless of their status.

sub should_process_transaction {
    my ($self, $transaction) = @_;
    $transaction->status eq $self->delegate->TXS_RUNNING;
}


# Give subclasses a chance to do transaction-wide processing. Normally you
# could do this by subclassing main() and doing your special stuff after
# $self->SUPER::main(@_), but some things affect the transaction handlers
# themselves. Still we don't want to do this before $self->SUPER::main(@_)
# because that would preclude more basic checks (such as done by this class's
# superclass).

sub before_iteration {}


sub main {
    my $self = shift;
    $self->SUPER::main(@_);

    $self->before_iteration;

    # Skip the rest of the stage run if we're marked as done. this might
    # happen if very basic things didn't work out.

    return if $self->done;

    my @extra_tx;
    our $factory ||= $self->delegate->make_obj('transaction_factory');
    my $factory_method = $self->factory_method;
    for my $payload_tx ($self->ticket->payload->transactions) {
        next unless $self->should_process_transaction($payload_tx->transaction);
        try {
            my $transaction_handler = $factory->$factory_method(
                tx     => $payload_tx,
                ticket => $self->ticket,
                stage  => $self,
            );

            $transaction_handler->run;

            # The transaction handler will accumulate exceptions in the
            # exception container of the payload item pointed to by the
            # current transaction.
            #
            # Transaction handlers can ask for extra tx to be run by further
            # stages.  For example, the policy transaction handler for
            # person.update can, when asked to modify otherwise immutable
            # owner fields, downgrade an owner to a contact when that owner
            # isn't used in a delegation. To do so, it adds a
            # person.set-contact tx so that the delegation can downgrade the
            # person.
            #
            # Transaction handlers do so via an extra_tx_list attribute, which
            # is processed here. We don't just push onto
            # $self->ticket->payload->transactions because we are iterating
            # over just that, and it's not recommended to change a list while
            # iterating over it.
            #
            # A null transaction handler - produced by a Class::Null entry in
            # the relevant hashes of the transaction factory - returns another
            # Class::Null object on each of its method calls, so here we'd be
            # pushing a Class::Null object onto @extra_tx. Avoid that.

            if ($transaction_handler->extra_tx_list_count) {
                push @extra_tx =>
                    grep { !UNIVERSAL::isa($_, 'Class::Null') }
                    $transaction_handler->extra_tx_list;
            }

        } catch Error::Hierarchy with {
            # Exception that was thrown, not recorded.
            $payload_tx->transaction->payload_item->exception_container->
                items_set_push($_[0]);
        };
    }

    $self->ticket->payload->add_transaction($_) for @extra_tx;
}


1;


__END__

=head1 NAME

Data::Conveyor - stage-based conveyor-belt-like ticket handling system

=head1 SYNOPSIS

None yet (see below).

=head1 DESCRIPTION

None yet. This is an early release; fully functional, but undocumented. The
next release will have more documentation.

=head1 TAGS

If you talk about this module in blogs, on del.icio.us or anywhere else,
please use the C<dataconveyor> tag.

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

Please report any bugs or feature requests to
C<bug-data-conveyor@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.

=head1 INSTALLATION

See perlmodinstall for information and options on installing Perl modules.

=head1 AVAILABILITY

The latest version of this module is available from the Comprehensive Perl
Archive Network (CPAN). Visit <http://www.perl.com/CPAN/> to find a CPAN
site near you. Or see <http://www.perl.com/CPAN/authors/id/M/MA/MARCEL/>.

=head1 AUTHORS

Marcel GrE<uuml>nauer, C<< <marcel@cpan.org> >>

Florian Helmberger C<< <fh@univie.ac.at> >>

Achim Adam C<< <ac@univie.ac.at> >>

Mark Hofstetter C<< <mh@univie.ac.at> >>

Heinz Ekker C<< <ek@univie.ac.at> >>

=head1 COPYRIGHT AND LICENSE

Copyright 2007 by Marcel GrE<uuml>nauer

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

